Dataset realicionado com amostras de vinhos tintos e brancos do norte de Portugal.
O objetivo é estimar a qualidade do vinho com base em suas características físico-químicas.
| fixedacidity | volatileacidity | citricacid | residualsugar | chlorides | freesulfurdioxide | totalsulfurdioxide | density | pH | sulphates | alcohol | quality | Vinho |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 6.6 | 0.24 | 0.35 | 7.70 | 0.031 | 36 | 135 | 0.99380 | 3.19 | 0.37 | 10.5 | 5 | WHITE |
| 6.7 | 0.34 | 0.43 | 1.60 | 0.041 | 29 | 114 | 0.99014 | 3.23 | 0.44 | 12.6 | 6 | WHITE |
| 10.6 | 0.31 | 0.49 | 2.20 | 0.063 | 18 | 40 | 0.99760 | 3.14 | 0.51 | 9.8 | 6 | RED |
| 5.4 | 0.18 | 0.24 | 4.80 | 0.041 | 30 | 113 | 0.99445 | 3.42 | 0.40 | 9.4 | 6 | WHITE |
| 6.7 | 0.30 | 0.44 | 18.75 | 0.057 | 65 | 224 | 0.99956 | 3.11 | 0.53 | 9.1 | 5 | WHITE |
| 6.8 | 0.50 | 0.11 | 1.50 | 0.075 | 16 | 49 | 0.99545 | 3.36 | 0.79 | 9.5 | 5 | RED |
sapply(Vinhos, function(x)all(is.na(x)))
## fixedacidity volatileacidity citricacid
## FALSE FALSE FALSE
## residualsugar chlorides freesulfurdioxide
## FALSE FALSE FALSE
## totalsulfurdioxide density pH
## FALSE FALSE FALSE
## sulphates alcohol quality
## FALSE FALSE FALSE
## Vinho
## FALSE
Observamos que não há nenhum valor ausente/faltante nesse dataset. Dessa forma, eliminamos a necessidade de tratar esses valores.
nearZeroVar(Vinhos)
## integer(0)
Não diagnosticamos preditores com um valor exclusivo (ou seja, preditores de variação zero) ou preditores com poucos valores exclusivos em relação ao número de amostras.
## 'data.frame': 6497 obs. of 13 variables:
## $ fixedacidity : num 6.6 6.7 10.6 5.4 6.7 6.8 6.6 7.2 5.1 6.2 ...
## $ volatileacidity : num 0.24 0.34 0.31 0.18 0.3 0.5 0.61 0.66 0.26 0.22 ...
## $ citricacid : num 0.35 0.43 0.49 0.24 0.44 0.11 0 0.33 0.33 0.2 ...
## $ residualsugar : num 7.7 1.6 2.2 4.8 18.8 ...
## $ chlorides : num 0.031 0.041 0.063 0.041 0.057 0.075 0.069 0.068 0.027 0.035 ...
## $ freesulfurdioxide : num 36 29 18 30 65 16 4 34 46 58 ...
## $ totalsulfurdioxide: num 135 114 40 113 224 49 8 102 113 184 ...
## $ density : num 0.994 0.99 0.998 0.994 1 ...
## $ pH : num 3.19 3.23 3.14 3.42 3.11 3.36 3.33 3.27 3.35 3.11 ...
## $ sulphates : num 0.37 0.44 0.51 0.4 0.53 0.79 0.37 0.78 0.43 0.53 ...
## $ alcohol : num 10.5 12.6 9.8 9.4 9.1 9.5 10.4 12.8 11.4 9 ...
## $ quality : int 5 6 6 6 5 5 4 6 7 6 ...
## $ Vinho : Factor w/ 2 levels "RED","WHITE": 2 2 1 2 2 1 1 1 2 2 ...
O dataset possui 6497 observações de 13 variáveis. Sendo elas numéricas, inteiras e fatoriais.
Dentre essas observações, podemos observar que a quantidade de vinhos brancos é maior do que vinhos tintos, conforme o gráfico abaixo:
barplot(table(Vinho), col=c(red_color, white_color))
Executando o summary:
## fixedacidity volatileacidity citricacid residualsugar
## Min. : 3.800 Min. :0.0800 Min. :0.0000 Min. : 0.60
## 1st Qu.: 6.400 1st Qu.:0.2300 1st Qu.:0.2500 1st Qu.: 1.80
## Median : 7.000 Median :0.2900 Median :0.3100 Median : 3.00
## Mean : 7.215 Mean :0.3397 Mean :0.3186 Mean : 5.44
## 3rd Qu.: 7.700 3rd Qu.:0.4000 3rd Qu.:0.3900 3rd Qu.: 8.10
## Max. :15.900 Max. :1.5800 Max. :1.6600 Max. :45.80
## chlorides freesulfurdioxide totalsulfurdioxide density
## Min. :0.00900 Min. : 1.00 Min. : 6.0 Min. :0.9871
## 1st Qu.:0.03800 1st Qu.: 17.00 1st Qu.: 77.0 1st Qu.:0.9923
## Median :0.04700 Median : 29.00 Median :118.0 Median :0.9949
## Mean :0.05603 Mean : 30.53 Mean :115.7 Mean :0.9947
## 3rd Qu.:0.06500 3rd Qu.: 41.00 3rd Qu.:156.0 3rd Qu.:0.9970
## Max. :0.61100 Max. :289.00 Max. :440.0 Max. :1.0140
## pH sulphates alcohol quality
## Min. :2.720 Min. :0.2200 Min. : 0.9567 Min. :3.000
## 1st Qu.:3.110 1st Qu.:0.4300 1st Qu.: 9.5000 1st Qu.:5.000
## Median :3.210 Median :0.5100 Median :10.3000 Median :6.000
## Mean :3.219 Mean :0.5313 Mean :10.4862 Mean :5.818
## 3rd Qu.:3.320 3rd Qu.:0.6000 3rd Qu.:11.3000 3rd Qu.:6.000
## Max. :4.010 Max. :2.0000 Max. :14.9000 Max. :9.000
## Vinho
## RED :1599
## WHITE:4898
##
##
##
##
Observamos que as variáveis residualsugar, chlorides, freesulfurdioxide e totalsulfurdioxide possuem valores muito distantes entre mínimo e máximo. Isso pode indicar outliers e/ou desequilíbrio entre a quantidade de vinhos tintos e brancos, o que pode interferir nos resultados de classificação.
Nessa tabela podemos observar a combinação entre o tipo do vinho e a nota de qualidade:
## quality
## Vinho 3 4 5 6 7 8 9
## RED 10 53 681 638 199 18 0
## WHITE 20 163 1457 2198 880 175 5
vinhos brancos possuem a nota máxima em relação a qualidade.Simétrico
Contêm a partir do centro do gráfico o maior número de dados.
Assimétrico à direita
Indica a ocorrência de altos valores com baixa frequência.
Assimétrico à esquerda
A frequência dos dados está concentrada nos altos valores.
Bimodal
Há o aparecimento de dois picos.
Multimodal
Há o aparecimento de vários picos.
library(randomForest)
## randomForest 4.6-14
## Type rfNews() to see new features/changes/bug fixes.
##
## Attaching package: 'randomForest'
## The following object is masked from 'package:outliers':
##
## outlier
## The following object is masked from 'package:ggplot2':
##
## margin
## The following object is masked from 'package:dplyr':
##
## combine
rfModel = randomForest( Vinhos$quality ~ ., data=Vinhos, ntree=500 )
varImpPlot(rfModel)
Abaixo temos o boxplot de todas as variáveis do dataset:
Com os gráficos acima foi observado que todas as variáveis possuem candidatos a outliers.
No dataset existem variáveis como residualsugar que possuem o valor máximo muito acima do terceiro quartil, isso pode gerar distorções nos algoritmos que serão executado a seguir. Além disso há uma concentração de outliers nessas variáriveis, o que traz a necessidade de removê-los para evitar distorção nos passos seguintes.
Nivelamento
VinhosOut <- Vinhos[Vinhos$quality > quantile(Vinhos$quality, .25) - 1.5*IQR(Vinhos$quality) & Vinhos$quality < quantile(Vinhos$quality, .75) + 1.5*IQR(Vinhos$quality), ]
Para realizar a correlação transformamos o campo Vinho (fator) para tipo numérico. Além de normalizar os dados para evitar algum tipo de distorção.
VinhosOut$Vinho <- as.numeric(VinhosOut$Vinho)
norm_vinhos <- VinhosOut %>% mutate_at(c(1,2,3,4,5,6,7,8,9,10,11,13), list( ~ c(scale(.))))
Obs.: Dataset sem outliers.
Outra forma de visualização da correlação das variáveis:
Com o gráfico de correlação podemos observar alguns pontos:
* O alcool tem uma anti-correlação alta com density
* O freesulfurdioxide tem uma correlação possitiva alta comtotalsulfurdioxide
* O volatileacidity tem uma anti-correlação alta com o tipo do vinho
* O totalsulfurdioxide tem uma correlação possitiva alta com o tipo do vinho
* As outras correlações não são tão significativas no dataset, nesse momento.
Iremos separar a base de dados em 25% para testes e 75% para treino. Conforme output abaixo:
norm_vinhos = data.frame(norm_vinhos)
dt_list = split_df(norm_vinhos, ratio = 0.75, seed = 66)
train = dt_list$train
test = dt_list$test
Validando a consistência de qualidade entre as bases de treino e teste
##
## 4 5 6 7
## 0.03359558 0.34616202 0.45183925 0.16840315
##
## 4 5 6 7
## 0.03703704 0.32567050 0.45402299 0.18326948
As proporções estão, consideravelemente, bem distribuídas entre a qualidade. Dessa forma, conseguimos realizar um bom treinamento para o modelo.
No primeiro modelo mantemos todas as varáveis:
##
## Call:
## lm(formula = train$quality ~ train$fixedacidity + train$volatileacidity +
## train$citricacid + train$residualsugar + train$chlorides +
## train$freesulfurdioxide + train$totalsulfurdioxide + train$density +
## train$pH + train$sulphates + train$alcohol + train$Vinho)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.70344 -0.43181 -0.02767 0.45035 2.10879
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.760137 0.009473 608.028 < 2e-16 ***
## train$fixedacidity 0.153899 0.021069 7.305 3.25e-13 ***
## train$volatileacidity -0.219021 0.014046 -15.593 < 2e-16 ***
## train$citricacid -0.019031 0.011968 -1.590 0.111858
## train$residualsugar 0.324917 0.028395 11.443 < 2e-16 ***
## train$chlorides -0.034948 0.011784 -2.966 0.003035 **
## train$freesulfurdioxide 0.084020 0.014315 5.869 4.68e-09 ***
## train$totalsulfurdioxide -0.071886 0.019182 -3.748 0.000181 ***
## train$density -0.407209 0.042495 -9.583 < 2e-16 ***
## train$pH 0.087345 0.015096 5.786 7.68e-09 ***
## train$sulphates 0.120756 0.011874 10.170 < 2e-16 ***
## train$alcohol 0.148646 0.020811 7.143 1.06e-12 ***
## train$Vinho -0.188577 0.025652 -7.351 2.30e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6494 on 4690 degrees of freedom
## Multiple R-squared: 0.286, Adjusted R-squared: 0.2841
## F-statistic: 156.5 on 12 and 4690 DF, p-value: < 2.2e-16
Nesse primeiro modelo a variável citricacid não possui muita relevância pois o seu p-value está próximo a 1.
Para ter certeza sobre essa informação, utilizamos o método stepwise para identificar quais são as variáveis relavantes para o modelo.
## Start: AIC=-4047.87
## train$quality ~ train$fixedacidity + train$volatileacidity +
## train$citricacid + train$residualsugar + train$chlorides +
## train$freesulfurdioxide + train$totalsulfurdioxide + train$density +
## train$pH + train$sulphates + train$alcohol + train$Vinho
##
## Df Sum of Sq RSS AIC
## <none> 1977.8 -4047.9
## - train$citricacid 1 1.066 1978.8 -4047.3
## - train$chlorides 1 3.709 1981.5 -4041.1
## - train$totalsulfurdioxide 1 5.922 1983.7 -4035.8
## - train$pH 1 14.117 1991.9 -4016.4
## - train$freesulfurdioxide 1 14.527 1992.3 -4015.4
## - train$alcohol 1 21.514 1999.3 -3999.0
## - train$fixedacidity 1 22.501 2000.3 -3996.7
## - train$Vinho 1 22.789 2000.6 -3996.0
## - train$density 1 38.723 2016.5 -3958.7
## - train$sulphates 1 43.612 2021.4 -3947.3
## - train$residualsugar 1 55.217 2033.0 -3920.4
## - train$volatileacidity 1 102.529 2080.3 -3812.2
Confiança desse modelo é:
## 2.5 % 97.5 %
## (Intercept) 5.74156468 5.778709611
## train$fixedacidity 0.11259442 0.195204549
## train$volatileacidity -0.24655872 -0.191483565
## train$citricacid -0.04249383 0.004431367
## train$residualsugar 0.26924956 0.380584049
## train$chlorides -0.05805011 -0.011845734
## train$freesulfurdioxide 0.05595510 0.112084743
## train$totalsulfurdioxide -0.10949146 -0.034279577
## train$density -0.49051957 -0.323899411
## train$pH 0.05774965 0.116940829
## train$sulphates 0.09747658 0.144034765
## train$alcohol 0.10784644 0.189446471
## train$Vinho -0.23886764 -0.138286615
Modelo sem a variável de citricidade:
##
## Call:
## lm(formula = train$quality ~ train$fixedacidity + train$volatileacidity +
## train$residualsugar + train$chlorides + train$freesulfurdioxide +
## train$totalsulfurdioxide + train$density + train$pH + train$sulphates +
## train$alcohol + train$Vinho)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.72469 -0.43083 -0.02888 0.45193 2.07950
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.760165 0.009475 607.933 < 2e-16 ***
## train$fixedacidity 0.146376 0.020534 7.128 1.17e-12 ***
## train$volatileacidity -0.211746 0.013283 -15.942 < 2e-16 ***
## train$residualsugar 0.325473 0.028397 11.461 < 2e-16 ***
## train$chlorides -0.037906 0.011638 -3.257 0.00113 **
## train$freesulfurdioxide 0.083967 0.014318 5.865 4.81e-09 ***
## train$totalsulfurdioxide -0.075122 0.019077 -3.938 8.34e-05 ***
## train$density -0.409961 0.042467 -9.654 < 2e-16 ***
## train$pH 0.089450 0.015041 5.947 2.92e-09 ***
## train$sulphates 0.119286 0.011840 10.075 < 2e-16 ***
## train$alcohol 0.145248 0.020705 7.015 2.62e-12 ***
## train$Vinho -0.191616 0.025585 -7.489 8.22e-14 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6495 on 4691 degrees of freedom
## Multiple R-squared: 0.2856, Adjusted R-squared: 0.2839
## F-statistic: 170.5 on 11 and 4691 DF, p-value: < 2.2e-16
O R-quadrado é de mais ou menos 30, o que significa que a regressão linear não descreve o modelo com tanta precisão.
Abaixo o modelo para base testes:
modeloTestSemCitricidade <- lm(test$quality ~ test$fixedacidity + test$volatileacidity + test$residualsugar + test$chlorides + test$freesulfurdioxide + test$totalsulfurdioxide+ test$density + test$pH + test$sulphates + test$alcohol + test$Vinho)
summary(modeloTestSemCitricidade)
##
## Call:
## lm(formula = test$quality ~ test$fixedacidity + test$volatileacidity +
## test$residualsugar + test$chlorides + test$freesulfurdioxide +
## test$totalsulfurdioxide + test$density + test$pH + test$sulphates +
## test$alcohol + test$Vinho)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.16513 -0.43737 -0.02119 0.46965 1.89032
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.77063 0.01667 346.194 < 2e-16 ***
## test$fixedacidity 0.15255 0.03772 4.044 5.50e-05 ***
## test$volatileacidity -0.24382 0.02265 -10.767 < 2e-16 ***
## test$residualsugar 0.29412 0.05431 5.416 7.05e-08 ***
## test$chlorides 0.02706 0.02394 1.130 0.258605
## test$freesulfurdioxide 0.10138 0.02464 4.114 4.09e-05 ***
## test$totalsulfurdioxide -0.07138 0.03343 -2.135 0.032919 *
## test$density -0.32288 0.08511 -3.794 0.000154 ***
## test$pH 0.13440 0.02677 5.020 5.76e-07 ***
## test$sulphates 0.09152 0.02051 4.462 8.68e-06 ***
## test$alcohol 0.21947 0.04314 5.087 4.08e-07 ***
## test$Vinho -0.13354 0.04634 -2.882 0.004010 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6566 on 1554 degrees of freedom
## Multiple R-squared: 0.2989, Adjusted R-squared: 0.294
## F-statistic: 60.24 on 11 and 1554 DF, p-value: < 2.2e-16
O modelo criado através da técnica de regressão linear não descreve muito bem a nota de qualidade dos vinhos, com uma acertividade de aproximadamente 30%. Não será necessário fazer o modelo de predição, devido ao baixo índice de acertividade.
Esse gráfico de resíduos apresenta a distância entre o valor estimado x valor real. Então, quanto mais próximo de zero o ponto estiver melhor é a assertividade do modelo.
Executa a predição do modelo:
## [1] 0.6243183
O percentual de acerto do modelo é de 62,43%
Executando o teste de shapiro no modelo:
##
## Shapiro-Wilk normality test
##
## data: residuals(modeloTestSemCitricidade)
## W = 0.99692, p-value = 0.003428
Como o p-value resultou em um valor menor que 0,05, não podemos assumir a normalidade.
Pode-se dizer que temos um modelo de regressão com pouca assertividade.
Isso corrobora com o valor d R-Quadrado demonstrando que modelo não é assertivo.
A seguir será executado a árvore de regressão para comparar com a regressão linear.
A árvore de regressão é um método de aprendizado supervisionado utilizado para classificação e regressão.
A variável target é a quality e as variáveis que utilizaremos para prever o seu valor são: fixedacidity, volatileacidity, citricacid, residualsugar, chlorides, freesulfurdioxide, totalsulfurdioxide, density, pH,sulphates,alcohol.
arvore_regressao = rpart (quality ~ fixedacidity + volatileacidity + citricacid + residualsugar + chlorides + freesulfurdioxide + totalsulfurdioxide + density + pH + sulphates + alcohol,data=train, cp = 0.007, minsplit = 15, maxdepth=30)
rpart.plot(arvore_regressao, type=4, extra=1, under=FALSE, clip.right.labs=TRUE,
fallen.leaves=FALSE, digits=2, varlen=-10, faclen=20,
cex=0.4, tweak=1.7,
compress=TRUE,
snip=FALSE)
## Warning: labs do not fit even at cex 0.15, there may be some overplotting
## Warning: cex and tweak both specified, applying both
Para esse plot, conseguimos visualizr variáveis representativas como:
alcohol, volatileacidity, residualsugar.
Erro utilizando o modelo de árvore de regressão:
Val_pred_tree = predict(arvore_regressao,interval = "prediction", level = 0.95)
mse_tree = mean((quality - Val_pred_tree)^2)
sqrt(mse_tree)
## [1] 0.6576832
Erro utilizando média:
erro_usando_media = mean((train$quality - mean(train$quality))^2)
sqrt(erro_usando_media)
## [1] 0.7674288
Pode-se dizer que o modelo de árvore de regressão é mais acertivo que o modelo de regressão linear. E pode-se dizer que a árvore tem uma acertividade melhor do que informando apenas a média como explicação da qualidade.
E para árvore de regressão pode-se dizer que a quantide de alcohol é fundamental para a qualidade do vinho seguindo de volatileacidity.
Adicionando a coluna de classificação dos vinhos e já separando base em teste/treino:
vinhos_com_classificacao = VinhosOut
vinhos_com_classificacao$classificacao = ifelse(vinhos_com_classificacao$quality >= 6, T, F)
dt_list_log = split_df(vinhos_com_classificacao, ratio = 0.75, seed = 66)
train_log = dt_list_log$train
test_log = dt_list_log$test
attach(train_log)
## The following objects are masked from train:
##
## alcohol, chlorides, citricacid, density, fixedacidity,
## freesulfurdioxide, pH, quality, residualsugar, sulphates,
## totalsulfurdioxide, Vinho, volatileacidity
## The following objects are masked from Vinhos:
##
## alcohol, chlorides, citricacid, density, fixedacidity,
## freesulfurdioxide, pH, quality, residualsugar, sulphates,
## totalsulfurdioxide, Vinho, volatileacidity
Executando o modelo com todos as variáveis:
modelo_logistico <- rpart (as.factor(classificacao) ~ fixedacidity+volatileacidity+citricacid+residualsugar+chlorides+freesulfurdioxide+totalsulfurdioxide+density+pH+sulphates+alcohol, maxdepth=20, train_log)
Resultado do modelo:
previsto.com.modelo<-predict(modelo_logistico, train_log, type='class')
matriz.de.confusao<-table(train_log$classificacao, previsto.com.modelo)
matriz.de.confusao
## previsto.com.modelo
## FALSE TRUE
## FALSE 974 812
## TRUE 457 2460
Calculando a diagonal da matriz
diagonal <- diag(matriz.de.confusao)
Acc <- sum(diagonal)/sum(matriz.de.confusao)
Acc
previsto.valid<-predict(modelo_logistico, test_log , type='class')
test$previsto=previsto.valid
test$classificacao <- ifelse(test$quality >= 6, T, F)
test$errou = ifelse(test$previsto != test$classificacao, 1, 0)
Matriz de confusão para a base teste
previsto.com.modelo<-predict(modelo_logistico, test_log, type='class')
matriz.de.confusao<-table(test_log$classificacao, previsto.com.modelo)
matriz.de.confusao
## previsto.com.modelo
## FALSE TRUE
## FALSE 287 281
## TRUE 148 850
Calculando a diagonal da matriz
diagonal <- diag(matriz.de.confusao)
Acc <- sum(diagonal)/sum(matriz.de.confusao)
Acc
Como técnica não supervisionada, vamos testar se o algoritmo de clusterização será adequado para agrupar dois conjunto de vinhos, categorizando-os como vinhos bons e vinhos ruins.
A variável quality, que identifica a nota do vinho, será a variável utilizada para correlacionar com as demais variáveis para identificar se existe algum agrupamento entre os vinhos.
De acordo com Luis Costa de Oliveira, Sara Oliveira, Maria Eugenia em seu artigo ‘Avaliação das características físico-químicas e colorimétricas de vinhos finos’, a cor não é uma característica físico-química. Portanto foi removida a coluna tipo de vinho.
| fixedacidity | volatileacidity | citricacid | residualsugar | chlorides | freesulfurdioxide | totalsulfurdioxide | density | pH | sulphates | alcohol | quality |
|---|---|---|---|---|---|---|---|---|---|---|---|
| -0.4812215 | -0.6119896 | 0.2164618 | 0.4756240 | -0.7226559 | 0.3258548 | 0.3420085 | -0.3264022 | -0.1749092 | -1.0921311 | 0.0423620 | 5 |
| -0.4040769 | -0.0021256 | 0.7632805 | -0.8106493 | -0.4383161 | -0.0784338 | -0.0293492 | -1.5741567 | 0.0740986 | -0.6202746 | 1.8002547 | 6 |
| 2.6045621 | -0.1850848 | 1.1733945 | -0.6841306 | 0.1872316 | -0.7137445 | -1.3379431 | 0.9690807 | -0.4861688 | -0.1484182 | -0.5436022 | 6 |
| -1.4069566 | -0.9779079 | -0.5354139 | -0.1358830 | -0.4383161 | -0.0206783 | -0.0470329 | -0.1048064 | 1.2568852 | -0.8899069 | -0.8784389 | 6 |
| -0.4040769 | -0.2460712 | 0.8316328 | 2.8056765 | 0.0166277 | 2.0007647 | 1.9158579 | 1.6372771 | -0.6729246 | -0.0136020 | -1.1295665 | 5 |
| -0.3269324 | 0.9736567 | -1.4239943 | -0.8317358 | 0.5284394 | -0.8292555 | -1.1787898 | 0.2361101 | 0.8833737 | 1.7390077 | -0.7947298 | 5 |
hier_cluster<-hclust(dist(vinhos_noColor),method='ward.D2')
d <- dist(norm_vinhos, method = "euclidean")
plot(hier_cluster, ylab='distancia', cex=0.6)
groups <- cutree(hier_cluster, k=4)
rect.hclust(hier_cluster, k=4, border="red")
* Divisão por 4 clusters.
Utilizando o K-means para descobrir a quantidade ideal de clusters dentro de 10 iterações.
set.seed(45)
wss = 0
for (i in 1:10) {
wine_cluster <- kmeans(vinhos_noColor, centers = i)
wss[i] <- wine_cluster$tot.withinss
}
plot(1:10, wss, type = "b", main="Elbow method",
xlab = "Number of Clusters",
ylab = "Within groups sum of squares",pch=8, col="red")
Com base na plotagem, podemos determinar que, após o cluster 3, não vemos uma grande queda na soma das distâncias quadradas dentro de cada cluster, portanto, podemos considerar o valor de K como 3 e prosseguir com o agrupamento.
## K-means clustering with 3 clusters of sizes 2842, 1574, 1853
##
## Cluster means:
## fixedacidity volatileacidity citricacid residualsugar chlorides
## 1 -0.3468971 -0.4233652 0.004285744 -0.4483549 -0.4379859
## 2 0.8624373 1.1769188 -0.326405161 -0.6076420 0.9196867
## 3 -0.2005368 -0.3503866 0.270686260 1.2038063 -0.1094608
## freesulfurdioxide totalsulfurdioxide density pH sulphates
## 1 -0.09039339 0.03739092 -0.8786450 -0.05406331 -0.2867921
## 2 -0.84292382 -1.19075490 0.7006338 0.54122535 0.8277140
## 3 0.85464658 0.95411939 0.7524616 -0.37681639 -0.2632265
## alcohol quality
## 1 0.5694176 5.989796
## 2 -0.1275825 5.572427
## 3 -0.7649595 5.574204
##
## Clustering vector:
## [1] 1 1 2 1 3 2 2 2 1 3 3 3 3 1 1 1 2 1 2 3 1 3 2 1 1 1 1 2 2 3 1 2 2 1
## [35] 2 2 1 3 1 3 3 3 1 2 1 3 1 1 1 1 1 1 1 2 1 1 1 2 2 1 3 1 1 2 1 1 2 1
## [69] 3 1 1 3 2 1 2 2 1 1 3 1 2 2 2 2 1 3 2 1 2 3 1 1 3 3 1 1 1 2 1 1 1 2
## [103] 1 1 1 1 3 1 1 1 1 1 1 1 1 2 3 1 3 1 1 2 2 3 2 2 1 3 2 2 3 1 3 3 3 1
## [137] 3 1 1 2 3 2 2 1 1 1 1 2 3 3 3 2 3 3 1 3 2 1 2 1 1 1 2 2 3 3 1 1 1 2
## [171] 1 3 1 2 3 2 1 1 3 3 1 3 1 3 1 2 1 3 1 3 3 1 3 2 3 1 3 1 2 3 2 1 1 2
## [205] 2 1 3 1 1 3 3 3 1 3 3 2 2 1 1 3 2 1 1 3 2 2 3 2 2 3 2 2 2 3 1 1 1 1
## [239] 3 1 3 1 1 1 1 3 2 3 3 3 2 2 2 1 1 1 1 3 1 1 3 3 1 2 1 3 2 2 1 3 2 2
## [273] 1 2 2 3 1 3 1 1 1 2 1 2 3 2 1 3 3 2 2 1 3 1 2 2 3 1 2 2 2 1 3 2 1 2
## [307] 2 3 3 1 3 1 1 1 2 2 3 2 1 3 3 2 2 1 3 2 3 1 2 1 3 1 2 2 2 1 1 1 1 1
## [341] 1 1 3 1 1 1 1 1 3 1 1 2 1 3 1 1 3 1 3 2 1 2 1 1 1 3 2 2 3 3 2 1 1 1
## [375] 1 2 1 3 2 3 1 2 2 1 3 2 1 3 1 1 3 1 1 2 2 1 1 3 1 1 3 2 2 3 3 3 3 3
## [409] 1 1 1 1 2 1 3 2 3 1 1 1 3 1 3 3 3 3 2 3 1 2 1 1 3 1 3 3 3 1 1 1 1 3
## [443] 2 1 1 1 3 3 1 1 1 1 1 1 1 3 1 1 1 2 1 1 1 1 3 1 1 3 3 3 1 1 2 3 1 2
## [477] 3 1 1 1 1 1 1 2 1 1 1 2 3 2 3 3 3 2 1 1 3 2 2 3 3 1 1 3 3 1 1 3 1 1
## [511] 2 1 1 2 3 2 2 3 3 2 1 1 2 3 1 2 3 3 3 3 3 1 1 2 1 2 1 1 1 3 3 3 3 1
## [545] 1 2 1 3 1 1 1 1 3 3 3 1 1 2 1 1 3 3 2 1 2 3 3 2 2 3 2 1 3 3 1 3 3 3
## [579] 3 3 2 2 2 2 2 1 3 1 1 1 2 3 1 2 1 2 1 1 3 1 1 2 1 2 1 2 3 2 2 3 3 3
## [613] 1 1 3 2 1 3 1 3 1 1 1 1 3 3 3 1 1 2 1 1 2 3 1 2 2 1 1 2 2 3 1 1 1 2
## [647] 3 3 1 1 1 1 3 2 1 3 2 3 2 3 3 1 2 1 3 1 2 2 1 1 2 1 3 3 3 3 1 2 1 1
## [681] 2 1 1 3 1 2 1 2 1 1 3 1 3 1 1 1 3 3 3 3 1 1 1 1 1 1 2 1 3 3 3 1 1 2
## [715] 2 3 1 1 1 2 1 1 2 2 2 2 1 2 1 3 1 2 2 2 3 2 1 1 2 1 2 1 2 3 2 3 1 1
## [749] 2 1 3 3 1 1 1 2 3 1 1 1 2 2 2 1 1 2 1 3 2 3 1 1 1 1 1 2 1 3 2 2 1 1
## [783] 3 3 2 3 3 2 3 1 1 2 2 2 2 3 3 3 2 1 1 1 1 3 3 1 1 1 3 1 1 1 2 3 1 3
## [817] 3 3 3 1 2 2 1 3 3 1 1 1 3 2 1 1 2 1 1 2 1 1 3 1 3 1 3 2 1 1 1 2 2 2
## [851] 2 1 1 1 2 1 3 1 1 1 1 1 2 1 1 2 1 1 2 1 3 1 3 3 3 2 3 1 2 1 3 3 1 2
## [885] 3 2 2 1 1 1 2 1 2 1 1 1 1 1 3 2 3 1 3 2 3 1 1 2 2 1 2 2 1 2 2 1 3 1
## [919] 1 1 1 1 2 1 3 1 1 1 3 2 1 3 1 2 2 3 2 1 2 2 3 1 1 1 1 2 3 3 1 3 1 3
## [953] 2 3 2 1 3 1 1 2 1 3 2 1 2 3 2 2 1 1 1 3 3 1 2 1 3 3 1 3 3 3 3 3 3 2
## [987] 2 3 1 2 2 1 1 3 2 3 3 2 1 3 3 1 2 2 3 3 3 1 3 1 1 1 1 1 2 3 2 1 1 1
## [1021] 1 2 1 3 2 1 1 3 1 2 3 2 2 3 3 1 2 1 1 2 3 3 1 2 3 1 2 2 1 1 2 3 3 2
## [1055] 3 2 2 1 3 3 1 2 1 3 1 3 1 2 3 1 3 1 1 2 1 2 1 2 3 3 1 1 1 1 3 1 2 1
## [1089] 1 1 3 1 3 3 3 1 3 1 1 1 2 3 1 1 2 3 1 3 3 1 3 1 1 2 1 1 1 2 1 1 2 3
## [1123] 3 2 3 1 3 1 2 2 1 3 3 1 1 1 1 1 3 1 1 1 3 2 3 2 2 3 3 3 1 1 2 2 1 3
## [1157] 1 3 2 1 3 2 1 3 3 2 2 3 2 1 1 1 2 1 1 2 3 2 2 3 3 2 1 1 3 3 2 1 1 3
## [1191] 1 1 2 1 3 3 3 2 1 2 1 3 3 1 1 2 2 1 1 3 1 2 1 3 1 1 1 1 1 1 1 1 1 2
## [1225] 2 2 2 3 1 3 1 1 2 2 1 1 2 2 1 3 3 2 2 2 1 3 1 2 3 3 3 1 3 1 1 2 1 3
## [1259] 1 1 3 1 1 1 3 3 3 1 2 2 3 3 2 3 1 1 1 3 1 1 2 1 1 1 3 3 2 2 3 2 1 2
## [1293] 3 3 2 2 2 1 3 1 3 1 1 2 1 1 2 2 3 1 1 1 1 2 2 1 2 2 3 1 1 2 1 1 1 3
## [1327] 1 1 2 2 1 1 1 1 3 1 1 1 1 2 3 1 1 3 3 3 1 3 3 1 1 1 3 3 3 1 1 2 2 3
## [1361] 2 1 3 3 2 3 2 3 2 3 3 1 1 3 3 1 2 1 1 1 1 3 1 1 2 1 3 3 2 1 1 1 1 3
## [1395] 2 3 2 2 3 1 3 3 1 2 3 2 1 1 1 1 2 3 1 2 3 3 2 2 3 1 2 2 3 1 2 2 1 2
## [1429] 3 3 1 3 2 2 1 1 3 1 1 2 3 3 2 1 1 2 2 1 1 1 1 1 2 3 2 3 1 3 3 1 1 1
## [1463] 1 3 1 3 2 3 2 1 3 3 1 3 3 1 2 1 3 3 1 1 3 3 3 2 1 1 2 3 2 3 1 2 3 1
## [1497] 1 1 3 1 1 2 2 1 3 1 1 1 1 2 1 1 3 3 3 1 1 3 1 2 1 1 1 2 3 3 1 2 1 3
## [1531] 2 3 1 1 1 1 3 3 2 1 3 3 1 1 3 1 1 1 1 3 3 3 2 1 1 1 1 3 1 3 1 1 3 3
## [1565] 3 1 2 1 2 1 3 1 2 3 1 2 1 1 1 1 1 2 1 3 2 3 2 1 2 3 1 2 2 1 1 1 2 1
## [1599] 1 2 1 1 1 3 1 1 1 3 1 2 1 3 1 1 3 3 1 1 3 2 3 2 1 1 3 1 2 2 1 1 2 1
## [1633] 2 1 1 2 2 3 2 2 2 1 1 2 2 1 2 3 1 1 1 1 1 2 1 1 1 1 1 2 1 1 3 2 1 1
## [1667] 3 2 3 1 3 2 3 2 1 3 1 1 3 1 2 1 2 2 2 1 1 1 1 1 3 1 3 2 2 1 2 3 1 2
## [1701] 1 3 2 1 1 2 3 1 1 1 2 2 1 3 1 1 1 1 1 3 1 3 3 1 2 2 2 2 3 1 3 3 1 3
## [1735] 1 3 2 1 1 2 1 3 1 1 3 3 3 2 3 1 1 1 3 3 2 2 1 2 3 3 1 3 3 1 1 3 2 1
## [1769] 2 2 1 2 1 1 1 2 1 3 1 3 3 1 2 3 1 1 3 1 1 1 1 3 1 1 1 1 2 2 2 1 3 1
## [1803] 1 2 2 1 3 1 1 1 2 1 1 3 2 3 1 2 1 3 3 3 1 1 2 3 3 3 3 2 2 3 1 2 3 1
## [1837] 1 1 3 3 3 2 1 3 2 3 1 3 1 3 1 1 1 1 1 2 1 1 3 1 2 1 1 3 1 3 2 1 2 3
## [1871] 1 3 1 3 3 1 3 1 1 2 1 1 3 3 3 1 1 3 2 2 3 3 1 1 1 3 3 3 1 1 1 2 2 1
## [1905] 3 1 1 1 1 1 1 3 2 2 2 1 1 1 3 2 1 1 3 2 1 2 3 3 1 3 1 1 1 3 2 1 2 3
## [1939] 3 2 1 3 1 1 1 3 1 2 3 1 2 3 1 1 1 2 1 1 3 1 1 2 1 2 3 2 1 3 3 2 2 1
## [1973] 2 1 1 3 1 1 1 2 2 3 2 2 3 1 1 1 2 3 1 2 3 1 3 3 1 3 3 3 1 1 1 1 2 3
## [2007] 1 2 1 2 3 1 3 1 3 2 2 1 1 3 1 1 1 1 3 1 1 1 1 1 3 1 2 3 1 3 3 3 1 2
## [2041] 3 3 1 2 2 2 1 1 1 1 2 1 1 2 3 1 3 3 1 2 2 3 2 2 2 1 3 3 1 2 2 3 3 3
## [2075] 1 2 1 2 1 2 1 3 1 2 2 2 3 3 3 1 3 2 1 3 2 1 1 1 3 3 2 1 3 2 3 1 3 1
## [2109] 2 3 3 2 3 2 2 2 1 1 1 3 2 1 3 2 2 2 2 1 1 1 3 1 3 1 1 2 3 1 2 3 1 1
## [2143] 1 1 3 2 3 1 1 2 3 2 1 1 1 1 1 3 1 2 3 3 1 2 2 1 2 3 3 2 3 2 1 2 1 1
## [2177] 3 1 2 3 1 3 1 2 2 3 1 3 3 1 2 1 3 1 3 1 1 2 1 1 1 3 2 1 3 1 2 1 3 1
## [2211] 1 2 1 2 1 1 1 1 1 2 3 1 3 1 3 2 2 1 1 2 3 1 3 2 1 3 2 1 3 1 1 2 3 3
## [2245] 3 3 2 3 1 1 2 3 2 1 3 3 3 1 1 1 3 1 1 3 1 1 2 1 3 2 3 1 3 1 3 2 1 1
## [2279] 1 1 3 3 3 1 3 1 1 1 3 3 1 2 1 1 2 1 1 2 3 3 1 3 3 1 1 2 3 3 2 2 1 3
## [2313] 3 2 3 1 2 1 1 3 2 1 1 3 3 3 1 2 2 1 3 2 1 1 3 2 1 3 3 2 1 1 2 2 1 1
## [2347] 1 1 2 1 2 1 3 3 2 2 2 3 2 1 2 3 3 3 2 3 3 3 3 3 3 2 2 1 3 3 1 1 3 1
## [2381] 3 2 3 2 2 3 2 2 3 2 3 2 1 1 2 2 2 1 1 1 3 1 2 2 1 3 2 1 1 1 1 3 2 3
## [2415] 3 2 2 2 2 3 2 3 2 2 2 3 2 3 2 1 2 1 2 3 1 3 2 1 3 2 3 1 1 3 2 1 2 1
## [2449] 1 2 1 1 3 2 1 3 1 3 1 1 2 2 2 1 1 1 1 3 3 1 2 1 1 2 1 2 1 2 2 1 1 1
## [2483] 3 3 1 1 3 1 3 3 2 2 2 3 2 2 2 1 1 3 1 1 1 1 1 1 2 1 2 3 3 1 3 2 1 2
## [2517] 1 3 1 2 3 3 1 2 3 1 3 2 3 1 3 1 3 2 1 1 1 3 3 1 1 3 3 1 2 1 3 2 1 2
## [2551] 1 3 2 3 1 2 2 1 1 3 3 1 1 2 3 3 3 3 2 1 1 1 1 1 2 1 1 1 1 2 2 2 3 2
## [2585] 3 1 2 1 2 3 3 2 3 3 2 1 1 2 2 1 1 1 1 3 3 1 3 3 3 1 2 2 3 1 1 1 3 1
## [2619] 1 2 3 1 2 3 2 3 1 1 3 1 1 2 2 3 1 2 1 3 1 1 3 1 3 2 3 1 1 1 2 1 1 1
## [2653] 1 1 1 2 1 2 1 1 1 3 3 3 3 2 2 1 3 1 3 1 1 1 1 1 3 3 3 2 3 3 1 3 1 3
## [2687] 1 1 1 1 3 1 3 2 2 2 3 2 1 1 1 1 2 2 1 1 1 1 1 1 3 2 2 3 2 1 1 3 1 3
## [2721] 1 3 3 1 1 1 3 3 1 1 1 2 2 1 1 2 2 1 2 1 2 3 3 1 1 2 2 1 1 1 3 2 1 1
## [2755] 3 2 1 2 2 2 2 1 1 1 1 3 1 1 1 2 2 2 3 2 1 3 3 1 2 3 2 1 1 2 2 1 1 1
## [2789] 3 2 2 3 2 2 2 1 3 2 1 3 3 3 3 3 2 3 2 2 2 2 1 3 3 1 1 3 3 1 3 3 2 2
## [2823] 3 2 3 1 3 1 3 2 3 3 3 2 3 3 2 1 3 3 3 2 3 1 1 3 3 1 3 1 3 3 2 1 3 2
## [2857] 2 1 2 1 1 3 3 3 1 3 3 2 2 2 3 1 1 2 3 1 3 2 1 3 1 1 2 1 1 1 2 1 3 1
## [2891] 3 1 3 2 1 2 1 2 1 1 1 2 2 2 2 2 2 3 2 2 1 2 3 3 3 1 1 3 3 2 2 1 1 1
## [2925] 1 3 1 3 1 3 2 1 3 1 1 1 1 1 1 2 1 1 1 2 3 1 2 2 1 1 2 1 1 1 1 2 3 2
## [2959] 3 3 1 1 3 2 3 1 2 3 1 1 1 1 3 1 1 2 2 1 1 1 1 1 1 1 2 2 2 2 1 3 2 1
## [2993] 2 1 1 1 3 3 1 1 1 2 3 1 1 3 2 1 1 1 2 1 1 1 2 2 3 1 2 3 3 1 2 1 2 1
## [3027] 3 2 1 1 1 1 3 3 1 1 1 3 1 3 1 3 1 2 1 3 1 3 2 1 2 3 1 3 2 1 1 2 1 2
## [3061] 1 1 2 1 1 1 2 3 2 2 1 1 2 1 1 1 2 1 1 1 3 2 1 2 1 2 1 1 1 2 1 3 1 2
## [3095] 1 2 1 1 3 1 1 3 1 3 2 3 2 2 3 1 3 1 2 1 2 3 1 1 1 1 1 2 1 3 2 1 2 2
## [3129] 1 1 1 1 1 3 2 2 1 2 1 2 3 1 2 2 1 3 2 1 1 1 2 1 2 2 2 1 3 1 2 1 1 2
## [3163] 3 2 2 3 1 1 2 3 2 3 2 2 1 2 1 3 3 1 3 3 2 2 3 2 1 1 1 3 2 2 3 2 1 1
## [3197] 1 3 1 2 3 1 1 3 1 3 2 2 3 3 2 2 2 3 1 1 2 1 1 1 2 1 3 1 3 3 2 3 1 3
## [3231] 1 2 3 2 1 1 1 2 1 1 3 3 3 3 2 1 2 3 3 3 3 1 2 2 1 1 2 1 3 1 2 1 3 1
## [3265] 3 1 3 3 3 2 1 3 1 3 3 3 3 1 2 1 1 3 2 3 3 3 2 1 1 1 2 2 1 2 1 3 1 1
## [3299] 3 1 3 3 2 1 3 3 1 2 1 3 1 2 3 2 3 2 2 1 2 3 1 2 1 2 2 3 2 1 1 2 3 3
## [3333] 3 1 1 1 1 2 1 1 1 2 1 1 1 3 1 3 3 2 1 2 3 3 2 1 3 1 3 1 1 1 1 2 1 2
## [3367] 2 1 1 2 2 1 2 2 1 2 1 2 1 3 3 1 3 1 3 1 3 3 1 3 3 2 2 2 3 3 3 1 2 3
## [3401] 3 3 1 3 1 1 1 3 3 1 1 3 2 2 1 1 1 1 3 1 3 3 1 2 1 1 1 1 1 2 2 2 1 1
## [3435] 1 1 1 3 3 3 1 1 2 1 1 3 1 2 3 3 2 1 1 3 3 1 1 1 1 1 1 1 2 2 1 2 3 1
## [3469] 2 1 2 1 2 1 1 2 2 1 1 2 1 3 2 3 1 1 1 2 1 1 1 1 1 2 1 1 3 1 3 3 2 1
## [3503] 3 1 3 2 3 2 3 3 2 3 2 3 2 3 1 3 2 1 2 3 2 3 1 3 1 1 1 1 3 1 2 1 2 3
## [3537] 1 1 3 3 1 1 2 1 1 3 3 3 2 2 1 3 1 2 2 3 1 1 1 2 2 1 1 1 1 1 2 1 1 3
## [3571] 2 2 2 3 1 1 1 3 2 1 3 1 3 1 2 2 1 2 2 2 3 1 1 2 1 3 3 1 2 1 1 3 2 1
## [3605] 2 3 1 3 1 2 1 3 2 3 1 2 1 2 3 1 3 1 3 2 1 3 3 1 1 3 1 3 1 1 2 3 2 3
## [3639] 2 1 3 3 2 2 1 2 2 3 2 3 3 3 3 1 2 1 1 3 2 2 1 3 2 3 2 2 1 2 3 3 3 1
## [3673] 2 3 3 1 1 3 1 3 2 1 2 2 3 2 1 1 1 2 1 3 1 3 2 3 3 1 3 2 3 1 1 3 1 2
## [3707] 1 1 1 3 1 1 1 3 3 2 2 1 1 1 1 2 2 3 3 2 2 3 1 1 1 1 3 1 3 2 3 1 3 1
## [3741] 1 3 3 1 3 3 2 1 1 1 1 1 2 3 3 1 3 3 1 3 1 1 2 1 1 2 3 2 3 2 1 3 2 2
## [3775] 1 1 2 1 2 3 1 1 1 2 3 2 1 2 3 2 1 1 1 2 1 3 1 2 3 3 3 3 1 2 2 2 3 1
## [3809] 3 3 2 3 3 3 3 2 2 1 3 3 2 1 1 1 1 1 1 3 1 1 2 3 2 1 2 3 2 3 2 1 2 1
## [3843] 1 2 1 1 3 2 1 3 3 1 1 3 1 3 1 1 1 2 1 1 2 3 1 1 3 3 3 1 1 3 3 3 1 2
## [3877] 3 1 3 1 3 1 2 1 1 3 3 3 3 3 1 1 3 1 1 2 3 1 2 1 3 1 1 1 1 2 1 2 3 1
## [3911] 1 1 1 1 1 1 1 1 3 1 1 2 3 1 1 1 3 1 3 3 1 2 1 2 1 1 3 3 1 1 1 2 1 3
## [3945] 1 1 3 1 1 1 1 1 1 1 1 3 1 2 3 1 3 3 1 1 3 1 3 1 2 2 2 3 3 3 2 1 1 3
## [3979] 1 3 1 1 2 2 3 3 1 1 1 1 3 2 1 3 2 1 3 2 3 1 1 2 1 1 1 2 1 3 1 2 1 2
## [4013] 1 3 1 3 1 3 3 3 1 3 3 1 3 3 2 1 3 1 1 3 3 1 1 1 1 1 3 3 1 3 1 3 1 2
## [4047] 2 2 1 2 3 1 1 3 1 1 1 2 1 3 2 2 2 3 1 1 1 1 2 1 3 3 1 2 3 1 3 3 3 1
## [4081] 1 3 2 3 1 1 3 1 1 1 1 3 1 2 2 1 1 1 3 1 1 1 2 1 1 1 1 3 1 1 2 3 1 2
## [4115] 1 3 2 1 1 3 1 3 1 2 1 1 1 2 2 1 1 3 2 3 3 3 3 3 2 3 1 3 1 1 1 1 2 3
## [4149] 1 2 3 1 1 1 3 2 3 1 2 3 2 3 2 2 2 1 2 2 3 3 2 2 2 2 3 1 1 3 3 3 2 2
## [4183] 1 1 1 1 1 3 1 3 3 1 1 1 1 3 1 1 1 3 3 1 2 1 1 1 2 2 3 1 2 2 3 2 2 1
## [4217] 2 2 1 3 3 2 1 1 3 3 1 1 1 1 3 1 2 1 2 2 2 2 3 1 3 2 3 1 1 2 1 2 3 1
## [4251] 3 3 2 3 1 1 1 3 1 2 2 3 3 1 1 1 1 3 3 1 1 3 1 1 3 2 2 3 2 2 3 3 1 1
## [4285] 2 3 3 1 1 3 3 3 3 2 1 3 2 1 3 1 2 3 1 1 3 1 1 1 1 1 3 1 3 1 3 1 1 1
## [4319] 1 1 3 3 2 1 1 2 1 3 1 1 1 2 3 1 1 1 1 1 1 1 1 3 2 2 1 2 1 2 1 3 2 3
## [4353] 1 2 1 1 1 2 3 2 1 3 2 3 1 1 3 3 1 2 1 2 3 1 1 1 1 2 1 1 1 1 2 1 2 2
## [4387] 1 1 1 2 1 2 2 1 2 2 1 1 1 2 3 3 3 2 3 2 1 1 2 1 1 1 3 1 1 1 2 1 1 3
## [4421] 2 1 1 3 2 1 3 3 2 1 3 2 2 3 2 2 1 2 1 1 1 1 1 1 1 2 1 1 3 1 1 1 1 1
## [4455] 2 1 1 3 2 1 1 3 2 2 1 3 1 2 3 3 2 3 1 1 1 3 1 1 2 2 3 1 1 3 1 3 3 1
## [4489] 2 1 1 2 1 2 2 2 1 2 2 3 3 1 2 1 1 2 3 1 1 2 1 1 3 1 3 1 1 1 1 2 2 1
## [4523] 3 2 1 3 2 1 3 1 1 1 1 2 1 2 1 1 2 1 2 2 1 1 1 1 1 3 3 2 1 3 3 3 1 1
## [4557] 3 3 2 1 3 1 1 1 3 3 1 3 2 3 1 2 1 1 2 1 3 3 3 2 1 3 1 2 1 1 3 1 1 2
## [4591] 1 3 3 2 1 2 1 2 2 3 1 1 2 3 2 1 1 3 2 3 3 3 1 3 3 3 2 2 2 3 1 2 1 1
## [4625] 2 2 1 1 3 3 3 2 2 3 1 3 2 2 3 3 2 1 1 3 2 2 3 2 3 1 2 1 3 1 2 1 3 2
## [4659] 1 3 2 2 1 3 3 1 1 3 2 2 3 3 3 1 1 2 1 3 3 1 1 2 1 2 1 3 1 3 1 3 1 1
## [4693] 2 1 2 2 1 2 1 3 2 2 3 2 3 3 2 1 3 1 1 3 1 2 2 1 1 1 3 2 1 3 1 1 1 1
## [4727] 3 3 1 2 1 1 3 2 3 3 1 1 1 3 3 3 1 1 2 1 2 2 1 1 1 3 3 3 3 3 1 1 1 3
## [4761] 3 1 2 1 3 3 2 1 3 2 1 2 2 1 3 1 1 3 1 1 3 1 2 3 3 3 3 1 3 3 3 1 1 3
## [4795] 1 1 1 2 1 2 1 3 3 1 3 1 1 1 1 1 1 2 2 3 1 1 1 1 3 3 1 1 3 3 1 2 1 1
## [4829] 3 3 3 3 3 3 1 2 2 1 3 1 1 2 2 1 1 2 1 3 2 3 2 3 3 1 3 1 1 1 1 3 1 3
## [4863] 3 1 3 1 2 1 2 3 2 2 1 1 3 3 1 3 2 1 1 2 1 1 3 1 1 1 1 1 1 2 1 3 1 1
## [4897] 2 3 1 3 1 1 1 1 1 1 2 3 3 1 3 1 1 3 1 1 1 2 2 3 1 1 2 3 1 2 2 2 3 1
## [4931] 1 3 2 2 1 3 1 3 1 2 1 3 1 1 1 1 2 2 3 1 1 3 2 1 1 1 2 2 1 1 1 1 3 1
## [4965] 1 2 1 1 2 3 3 1 1 1 1 3 1 1 1 1 3 1 3 3 3 2 2 1 3 1 3 2 3 1 1 1 1 1
## [4999] 2 3 1 1 1 3 1 1 1 1 1 1 3 1 1 2 3 3 1 3 1 2 1 1 1 1 1 1 1 3 1 1 2 2
## [5033] 2 3 3 1 1 1 1 2 1 1 2 1 1 3 3 2 1 3 3 2 3 2 2 1 1 3 2 2 1 3 1 2 2 3
## [5067] 3 3 3 1 2 1 1 1 1 1 3 3 2 2 3 2 1 1 1 1 2 1 3 2 1 2 1 3 1 1 1 3 3 2
## [5101] 2 3 2 3 1 2 3 2 2 3 2 1 1 2 1 1 2 1 1 3 3 1 3 2 1 3 1 1 3 1 1 3 2 1
## [5135] 1 1 3 2 2 1 3 3 2 3 3 3 1 3 2 1 1 1 2 3 2 1 1 3 1 1 1 1 1 3 2 1 1 1
## [5169] 3 3 2 1 2 1 3 3 2 2 2 1 2 1 1 3 1 1 1 1 1 2 1 2 2 3 1 1 3 2 2 3 1 2
## [5203] 3 2 1 3 1 1 2 1 2 2 1 3 1 1 1 3 1 2 1 1 2 2 3 3 1 1 3 3 3 1 3 3 1 2
## [5237] 2 3 2 1 1 3 1 1 2 2 1 1 1 2 3 3 1 3 3 2 1 1 1 3 1 2 3 3 3 2 1 1 1 3
## [5271] 2 1 1 2 1 1 1 3 2 3 2 1 3 1 1 1 2 1 1 1 3 1 2 1 1 2 1 1 2 2 3 2 2 1
## [5305] 3 1 1 1 3 3 1 2 2 3 1 1 2 2 1 1 1 2 2 3 1 1 3 3 1 3 3 1 1 1 1 1 1 1
## [5339] 3 1 3 1 1 2 2 2 1 2 3 3 3 2 1 1 3 2 3 2 1 2 1 1 2 1 3 3 3 2 3 1 1 1
## [5373] 2 3 1 3 1 3 3 3 1 1 3 3 1 2 1 2 1 2 3 1 3 2 1 2 2 2 3 3 1 2 3 1 2 1
## [5407] 1 1 3 3 2 1 1 2 1 1 3 2 2 1 3 1 3 1 2 2 1 3 1 1 1 3 1 1 3 2 3 2 1 1
## [5441] 2 3 1 3 1 1 2 2 1 3 1 3 3 3 1 2 2 3 2 1 3 2 2 1 1 1 2 2 1 2 3 1 3 2
## [5475] 1 1 2 2 3 3 2 1 1 1 1 1 3 3 1 3 2 1 3 1 1 3 3 3 2 1 1 3 3 1 1 3 3 1
## [5509] 3 2 1 1 1 1 1 3 1 3 3 3 3 3 3 1 3 3 1 1 2 1 1 3 1 1 3 1 3 2 1 3 2 1
## [5543] 1 1 3 3 2 1 1 3 3 1 3 1 2 3 3 3 1 3 3 1 2 3 1 1 1 2 1 3 2 1 1 2 1 1
## [5577] 3 1 1 1 2 3 3 3 1 1 1 2 1 2 1 3 1 2 1 1 3 1 3 2 1 3 3 1 1 2 1 3 2 1
## [5611] 1 2 3 3 1 2 1 3 1 3 1 1 3 1 1 3 3 1 1 1 1 2 3 3 1 2 1 3 3 3 3 2 2 3
## [5645] 3 3 2 2 1 2 2 2 3 1 2 3 3 2 1 2 1 1 1 1 2 3 3 1 1 1 1 3 2 3 1 3 1 3
## [5679] 3 1 3 1 1 1 2 1 1 3 3 1 2 1 1 3 2 1 3 3 3 1 1 1 1 3 1 1 1 1 3 2 2 1
## [5713] 2 3 1 2 2 1 1 1 3 1 1 1 2 3 1 3 2 3 3 2 3 1 1 1 1 1 2 1 1 3 1 1 3 3
## [5747] 3 1 2 1 3 2 3 1 3 2 2 2 2 3 3 1 1 1 3 3 1 2 3 3 3 3 1 2 3 2 1 1 1 3
## [5781] 2 1 2 1 1 1 2 2 1 3 1 1 2 1 3 1 2 1 2 1 2 2 3 3 1 1 1 3 2 1 1 2 1 2
## [5815] 2 1 3 3 1 2 3 3 3 2 3 3 1 3 1 1 3 1 1 3 2 1 3 3 2 1 1 1 1 3 1 3 1 3
## [5849] 2 1 3 2 2 2 2 1 1 1 2 1 1 2 2 2 1 1 1 2 1 3 3 2 1 2 3 2 2 2 3 1 1 3
## [5883] 2 1 3 1 2 1 1 1 1 1 3 1 3 3 1 3 2 1 3 2 3 3 2 3 1 1 2 2 3 1 1 3 1 3
## [5917] 1 2 3 1 3 1 2 3 3 1 2 1 2 2 3 3 3 1 1 1 3 1 2 3 2 3 3 1 1 1 3 1 1 3
## [5951] 2 3 3 3 1 1 1 1 1 1 3 1 1 1 3 3 2 1 1 3 1 1 3 3 1 1 1 1 2 3 3 1 1 1
## [5985] 3 1 2 3 3 3 1 1 3 1 3 3 1 1 1 1 3 3 3 1 1 2 1 1 1 3 1 1 2 1 2 1 2 3
## [6019] 2 1 3 1 1 3 1 3 3 1 2 1 3 1 2 3 1 1 1 2 1 3 2 1 3 1 2 3 1 3 1 2 2 3
## [6053] 1 1 1 1 3 3 3 1 1 3 1 1 2 3 3 3 3 1 1 3 1 1 3 3 1 3 3 3 2 1 2 1 1 1
## [6087] 1 1 2 1 1 1 2 3 3 1 3 1 3 1 1 1 2 3 1 3 1 1 3 3 1 2 2 1 2 2 3 1 1 1
## [6121] 1 1 1 2 1 1 2 3 1 1 1 2 2 2 2 1 1 1 1 2 3 2 3 1 1 2 1 3 3 3 3 1 1 3
## [6155] 1 1 1 1 3 1 3 2 1 1 3 1 1 2 2 1 1 1 2 1 3 2 1 2 2 1 1 3 3 3 1 2 3 3
## [6189] 1 1 3 1 1 1 3 3 3 1 3 1 1 1 2 1 2 1 1 2 3 2 3 1 3 1 3 1 1 2 3 3 1 2
## [6223] 1 1 2 1 2 3 1 2 3 2 1 3 3 1 3 2 2 3 2 1 1 3 3 2 3 1 3 1 3 3 1 2 2 1
## [6257] 1 1 2 1 2 2 1 1 3 1 1 1 1
##
## Within cluster sum of squares by cluster:
## [1] 17530.05 17906.78 11785.89
## (between_SS / total_SS = 35.0 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss"
## [5] "tot.withinss" "betweenss" "size" "iter"
## [9] "ifault"
## segmento
## 1 2 3
## 2842 1574 1853
Quantidade de interações até chegar nos clusters:
## [1] 4
| Group.1 | fixedacidity | volatileacidity | citricacid | residualsugar | chlorides | freesulfurdioxide | totalsulfurdioxide | density | pH | sulphates | alcohol | quality |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | -0.3468971 | -0.4233652 | 0.0042857 | -0.4483549 | -0.4379859 | -0.0903934 | 0.0373909 | -0.8786450 | -0.0540633 | -0.2867921 | 0.5694176 | 5.989796 |
| 2 | 0.8624373 | 1.1769188 | -0.3264052 | -0.6076420 | 0.9196867 | -0.8429238 | -1.1907549 | 0.7006338 | 0.5412253 | 0.8277140 | -0.1275825 | 5.572427 |
| 3 | -0.2005368 | -0.3503866 | 0.2706863 | 1.2038063 | -0.1094608 | 0.8546466 | 0.9541194 | 0.7524616 | -0.3768164 | -0.2632265 | -0.7649595 | 5.574204 |
Grupo 4 tem acido volatil e ph altos, Grupo 2 são os vinhos com bastante residuos de açucar e menos alcolícos.
Com a dataset sem o tipo do vinho foi testado o método dos Componentes Principais:
acpcor <- prcomp(vinhos_noColor, scale = TRUE)
summary(acpcor)
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6
## Standard deviation 1.7531 1.6186 1.2844 1.03650 0.90988 0.80824
## Proportion of Variance 0.2561 0.2183 0.1375 0.08953 0.06899 0.05444
## Cumulative Proportion 0.2561 0.4744 0.6119 0.70142 0.77041 0.82485
## PC7 PC8 PC9 PC10 PC11 PC12
## Standard deviation 0.74724 0.71475 0.68246 0.55115 0.47795 0.18598
## Proportion of Variance 0.04653 0.04257 0.03881 0.02531 0.01904 0.00288
## Cumulative Proportion 0.87138 0.91395 0.95277 0.97808 0.99712 1.00000
Pode-se observar que o número de componentes prinpais que explicam a maior parte dos componentes é 3, por tanto, decidiu-se por utilizar 3 componentes.
Criando um novo dataset com os componentes princpais
vinhos_cpa <-cbind(escore1,escore2, escore3,escore4 ,escore5)
Determinando a quantidade de clusters
Com base na plotagem, podemos determinar que, após o cluster 3, não vemos uma grande queda na soma das distâncias quadradas dentro de cada cluster, portanto, podemos considerar o valor de K como 3 e prosseguir com o agrupamento.
set.seed(333)
output_cluster<-kmeans(vinhos_cpa,3,iter=100)
clus_vinhos_cpa<-output_cluster$cluster
table (clus_vinhos_cpa)
## clus_vinhos_cpa
## 1 2 3
## 1600 1924 2745
Assim os vinhos ficam agrupados da seguinte maneira
| Group.1 | fixedacidity | volatileacidity | citricacid | residualsugar | chlorides | freesulfurdioxide | totalsulfurdioxide | density | pH | sulphates | alcohol | quality | Vinho |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | 0.8460029 | 1.1610755 | -0.3249314 | -0.6052805 | 0.9061316 | -0.8441997 | -1.1728104 | 0.6882294 | 0.5334011 | 0.8144639 | -0.1332965 | 5.553125 | -1.5993643 |
| 2 | -0.1981442 | -0.3470284 | 0.2550077 | 1.1412774 | -0.1139558 | 0.8286189 | 0.9426569 | 0.7189004 | -0.3709510 | -0.2700960 | -0.7657535 | 5.546258 | 0.5734281 |
| 3 | -0.3542351 | -0.4335294 | 0.0106578 | -0.4471289 | -0.4482913 | -0.0887225 | 0.0228870 | -0.9050387 | -0.0509042 | -0.2854199 | 0.6144204 | 6.035337 | 0.5303123 |